perm filename PICX.F4[PIC,LCS] blob sn#085794 filedate 1974-02-03 generic text, type T, neo UTF8
00100		SUBROUTINE READR(NNW)
01000		COMMON JXX(4000),JCNT
01100		COMMON/COMMAC/FLINE,LLINE,LSIDE,RSIDE,NEWEND
01200
01400		INTEGER FLINE,RSIDE,FILE
01500	CC	LOGICAL FUNCTION ADMISS
01600	CC	ADMISS(DTA)=DTA.EQ.-7.OR.(1.LE.DTA.AND.DTA.LE.10)
03500		READ(1) JCNT,(JXX(K),K=1,JCNT),FLINE,LLINE,LSIDE,RSIDE
03600		END
06170		SUBROUTINE PLOU(NWW)
06200		COMMON/PLT/JX,JY,JPL,PLT,REV,RINV,ROT,RLR,RUD,CONST,E
06300		1 ,JREV,JINV,KA,KB,KC,KD,RTO,JA,JB,JAR,JBR,A,IA,IB,IC,ID
06400	C  KA-D IS FOR INVIS. INNER AREA.  IA-D IS FOR INVIS. OUTER AREA.
06500	
06510		COMMON/CLR/KP,KQ,KR,KS,P/MEDGE/MC,MD,RMC,MMD
06600		COMMON/DDP/IDP1(4000),INP(10,20)/FU/FUJ(512),JJX,RDIV,ADML
06900		COMMON/COMMAC/FLINE,LLINE,LSIDE,RSIDE,NEWEND
07100		INTEGER FLINE,RSIDE
07200		DATA NEWX/0/,NCNT/0/,JMC/1554/,JMD/1380/
07250		NEWEND=NWW
07300		IF(NEWEND)GO TO 6002
07400		IF(NEWX)GO TO 1
07500		RTO=6
08000		NX=0
08100		NY=0
08200	
08300	1001	FORMAT(A1,3F)
08400	1000	FORMAT(' D, P, S, M OR T    HORZ.%,VRT.%,   ROTATION'/)
08500	6100	FORMAT(' INNER CLEAR AREA L-R-BT-TP%  OUTER L-R-B-T%
08600		1   REV=1, INV=1   OTHER CLEAR AREA'/)
08700	6001	FORMAT(14F)
08800	1	CALL JZERO
08900		JX=0
09000		JY=0
09100		CONST=0
09200		TYPE 1000
09250	C  C=CLEAR,  T=TYPE INPUT, R=RETURN TO MAIN.
09300		ACCEPT 1001,WHICH,RLR,RUD,ROT
09305		IF(WHICH.EQ.'R')RETURN
09310		IF(WHICH.NE.'C')GO TO 24
09320		NEWX=0	
09330		GO TO 1
09400	24	IF(NCNT.LT.20.AND.WHICH.NE.WX)NCNT=NCNT+1
09500		REREAD 3,(INP(NA,NCNT),NA=1,10)
09600		IF(WHICH.NE.'H')GO TO 8002
09700		TYPE 9002
09800		GO TO 1
09900	9002	FORMAT(' D=DISPLAY, P=PLOT, S=SAVE FOR DRAWING PROG.'/
10000		1 ' M=MOVE, T=TYPE MY INPUT BACK.'/)
10100	8002	IF(WHICH.NE.'T')GO TO 3002
10110	6002	TYPE 91,RDIV,JJX
10155	91	FORMAT(' CENTR=',F6.2,'   STEP=',I2)
10200		DO 4002 K=1,NCNT
10300	4002	TYPE 5002,(INP(NA,K),NA=1,10)
10400		IF(NEWEND)RETURN
10500		GO TO 1000
10600	3002	IF(WHICH.EQ.'M')GO TO 3102
10700		TYPE 6100
10800		ACCEPT 6001,A,B,C,D,E,F,G,H,REV,RINV,P,Q,R,S
10805	C  TYPE -1 TO REPEAT LAST INPUT
10810		IF(A.GE.0)GO TO 33
10820	C  REPEATS LAST INPUT
10823		A=AA
10826		B=BB
10829		C=CC
10832		D=DD
10835		E=EE
10838		F=FF
10841		G=GG
10844		H=HH
10847		REV=RREV
10850		RINV=RRINV
10853		P=PP
10856		Q=QQ
10859		R=RR
10862		S=SS
10865	33	AA=A
10868		BB=B
10871		CC=C
10874		DD=D
10877		EE=E
10880		FF=F
10883		GG=G
10886		HH=H
10889		RREV=REV
10892		RRINV=RINV
10893		SS=S
10895		PP=P
10898		QQ=Q
10899		RR=R
10900		IF(NCNT.LT.20.AND.WHICH.NE.WX)NCNT=NCNT+1
11000		REREAD 3,(INP(NA,NCNT),NA=1,10)
11100	3102	JPL=3
11200		WX=WHICH
11300	C  SO IT WON'T COUNT RETRIES.
11400	3	FORMAT(10A5)
11500	5002	FORMAT(1X10A5)
11600	C  FAC=SIZE BY 100'S, RLR=LEFT-RIGHT SIZE, RUD=UP-DOWN SIZE
11700	C-- D 0 0    0,50,0,50 CLEARS LOWER LFT QUAD. 50 100 50 100 UPR RT.
11800	C  TYPE 'T' TO GET BACK ALL INPUT LINES.
11900		IF(A+B+C+D.EQ.0)A=-1.
12100		IF(WHICH.NE.'S')GO TO 7002
12400	7002	IF(WHICH.EQ.'M')GO TO 2002
12500		IF(E+H+F+G.EQ.0)E=-1.
12510		IF(P+Q+R+S.EQ.0)P=-1.
12600		IF(RLR.EQ.0)RLR=100.
12700		IF(RUD.EQ.0)RUD=100.
12800		IF(ROT.EQ.1)RINV=RINV-1
12900	2002	RLR=RLR/100.
13000		RUD=RUD/100.
13100		PLT=0
13200		IF(WHICH.NE.'D')GO TO 1002
13300	C  DPY IS 1/3 SIZE OF PLOT.
13400		GO TO 2000
13500	
13600	1102	IF(WHICH.NE.'M')GO TO 1
13700	C  MOVE PEN, L-R%, U-D
13800	2200	RX=JMC
13900		RY=JMD
14000		NX=RX*RLR
14100		NY=RY*RUD
14200		RLR=.01
14300		RUD=.01
14400		GO TO 67
14500	
14600	1002  IF(WHICH.NE.'P')GO TO 1102
14800	
14900	2000	IF(NEWEND.GT.1000) PAUSE 'NEWEND>1000'
15000	67	MA=0
15100		MB=0
15200		MC=(RSIDE-LSIDE)*RTO*RLR+.5
15300		MD=(LLINE-FLINE)*RTO*RUD+.5
15310		JREV=MC/JPL
15355		JINV=MD/JPL
15400		JM=-380
15500		KM=-200
15600		IF(NEWX)GO TO 655
15700		JMC=MC
15800		JMD=MD
15900	655	JQX=NX
16000		JQY=NY
16100		IF(WHICH.EQ.'M')GO TO 671
16600	CC	JREV=(JA+JC)/JPL
16700	C	JINV=(JB+JD)/JPL
16800		KA=0
16900		KB=0
17000		KC=0
17100		KD=0
17110		KP=0
17120		KQ=0
17130		KR=0
17140		KS=0
17200		IA=-1
17300		IB=99999
17400		IC=-1
17500		ID=99999
17600	671	IF(NEWX.NE.-1)CALL DPYSET(1,IDP1,4000)
17700		CALL SETPOG(1)
17800		CALL TYPLOC(-300,-611)
17900		CALL DPYBRT(6)
18000		JX=NX/JPL
18100		JY=NY/JPL
18200		CALL AIVECT(-380,-200)
18300	672	JA=0
18400		JB=0
18500		NC=MC/JPL
18600		ND=MD/JPL
18650		CALL DSTORT(JPL)
18700		CALL LINES(3)
18800	CC	CALL JZERO
18900		JA=NC
19000		JB=0
19100		CALL LINES(2)
19200		JA=NC
19300		JB=ND
19400		CALL LINES(2)
19500		JB=ND
19600		JA=0
19700		CALL LINES(2)
19800		JA=0
19900		JB=0
20000		CALL LINES(2)
20100		CALL DPYOUT(1)
20200		IF(WHICH.NE.'M')GO TO 2683
20300	168	NY=JQY
20400		NX=JQX
20500		GO TO 1
20600	2683	NQ=0
20700		IF(A)GO TO 1683
20800		KA=MC*(A/100.)
20900		KB=MC*(B/100.)
21000		KC=MD*(C/100.)
21100		KD=MD*(D/100.)
21200		CALL INVIS(KA,KB,KC,KD,NQ)
21210	1683	IF(P)GO TO 9683
21220		KP=MC*(P/100.)
21230		KQ=MC*(Q/100.)
21240		KR=MD*(R/100.)
21250		KS=MD*(S/100.)
21260		CALL INVIS(KP,KQ,KR,KS,NQ)
21300	9683	IF(E)GO TO 8683
21400		IA=MC*(E/100.)
21500		IB=MC*(F/100.)
21600		IC=MD*(G/100.)
21700		ID=MD*(H/100.)
21800		CALL INVIS(IA,IB,IC,ID,NQ)
21900		IF(PLT.EQ.0)E=-1
22000	8683	IF(PLT.NE.0)JPL=1
22100		KA=KA/JPL
22200		KB=KB/JPL
22300		KC=KC/JPL
22400		KD=KD/JPL
22410		KP=KP/JPL
22420		KQ=KQ/JPL
22430		KR=KR/JPL
22440		KS=KS/JPL
22500		IA=IA/JPL
22600		IB=IB/JPL
22700		IC=IC/JPL
22800		ID=ID/JPL
22900		TYPE 683
23000	683	FORMAT(' OK?'/)
23100		ACCEPT 1001,NA
23200		IF(NA.EQ.'N')GO TO 168
23300		JX=NX/JPL
23400		JY=NY/JPL
23500	CC	IF(PLT.NE.0)GO TO 1681
23600	6852	CALL CLRPOG(2)
23700		CALL SETPOG(1)
23800	CC	JA=-380
23900	CC	JB=-200
24000		CALL JZERO
24100		CALL AIVECT(-380,-200)
26800	685	JAR=0
26900		JBR=0
27000		JREV=MC/JPL
27100		JINV=MD/JPL
27200		IF(CONST)PLT=-2
27210		CALL DSTORT(JPL)
27300		CALL PLTMAN
27400		NEWX=-1
27500		NX=JQX
27600		NY=JQY
27700		WX=0
27900		END